Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyOOMainLoop.p

Text File | 1995-10-23 | 33.1 KB | 1,363 lines | [TEXT/CWIE]

unit MyOOMainLoop;

interface

    uses
        Quickdraw, Windows, Dialogs, AppleEvents, Drag,
        MyFMenus;

    const
        WT_NotMine = 'NtMe';
        WT_Generic = 'Genr';
        bad_window_id = -1;
        kAECloseAll = 'Clos';

    type
        SCType = (SCSave, SCCancel, SCDiscard);
        WObject = object
                window: dialogPtr;
                resid: integer;
                window_type: OSType;
                window_id: longInt;
                growRect: rect; { minimum/maximum rect size (for use with grow window) }
                zoomSize: point; { Optimum zoom size }
                zoomed: boolean;
                unzoomed: rect;
                draw_grow_icon: boolean;
                is_active: boolean;
                is_default_object: boolean;
                close_hides_window: boolean;
                popup_title_menu: MenuHandle;
                AppleGuideWindowType: str31;
                onlyone: ^WObject;    { Set onlyone^ to nil when we destroy ourselves }
                timetoclose:boolean;
                procedure JointCreate (id: integer);
                procedure Create (id: integer);
                procedure CreateBehind (id: integer; behind: WindowPtr);
                procedure Destroy;
                procedure GetWindowPos (h: handle);
                procedure SetWindowPos (h: handle; var wasvisible: boolean);
                function SaveChangesID (alert_id: integer): integer;
                function SaveChanges: SCType;
                procedure DoClose;
{ DoClose checks modified things etc, then calls Destroy }
                function SetMenuBar: boolean;
                procedure SetMenus;
                function EditMenuEnabled: boolean;
                procedure SetEditMenuItem (item: integer);
                procedure DoEditMenu (item: integer);
                function GetAESelection (var reply: AppleEvent): OSErr;
                function GetAEWindow (var windowrec: AERecord): OSErr;
                function DoMenuKey (er: eventRecord; ch: char): longInt;
                procedure CalculateRegion (var rgn: rgnHandle);
                function WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
                procedure DoIdle;
                procedure DoIdleAlways;
                procedure DoDiskEvent (message: longInt);
                procedure DoSuspendResume (resume: boolean);
                procedure DoHighLevel (er: eventRecord);
                procedure DoContent (er: eventRecord);
                procedure DoKey (modifiers: integer; ch: char; code: integer);
                procedure DoSpecialKey (modifiers: integer; ch: char; code: integer);
                procedure DoAutoKey (modifiers: integer; ch: char; code: integer);
                procedure DoPopupTitle (choice: integer);
                function CheckPopupTitle (where: Point): boolean;
                procedure DoDrag (where: point);
                procedure DoGrow (where: point);
                procedure Zoom (zoomout: boolean; fullscreen: boolean);
                procedure DoZoom (where: point; code: integer);
                procedure DoGoAway (where: point);
                procedure DoUpdate;
                procedure DoMouseMoved (where: point);
                procedure DrawGrow;
                procedure DoActivateDeactivate (activate: boolean);
                procedure TextChanged; { called for paste/clear/cut/key down etc }
                procedure Resize;
                procedure InitialZoom (h, v: integer);
                procedure Draw;
                function TrackingHandler (message: DragTrackingMessage; dragref: DragReference): OSErr;
                function ReceiveHandler (dragref: DragReference): OSErr;
                function DragSend (flavor: FlavorType; item: ItemReference; dragref: DragReference): OSErr;
                function DoSetupDrag (dragref: DragReference; dragrgn: RgnHandle): OSErr;
                procedure DoTrackDrag (var er: EventRecord);
                function DoMainClick (er: eventRecord; wp: windowPtr; code: integer): boolean;
                function DoIsDialogEvent (er: eventRecord): boolean;
                function DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
                function HandleSimpleEvents (er: eventRecord): boolean;
                function HandleEvents (er: eventRecord): boolean;
            end;
        DObject = object(WObject)
                ok_item, cancel_item, outline_item: integer;
                handle_activate_outline: boolean;
                handle_shift_tab: boolean;
                disable_edit_menu: boolean;
                text_return: boolean;
                procedure Create (id: integer);
                override;
                procedure CreateBehind (id: integer; behind: WindowPtr);
                override;
                procedure Destroy;
                override;
                procedure SetOOOutline (def_item, user_item: integer);
                procedure DrawOutline;
                procedure DoActivateDeactivate (activate: boolean);
                override;
                function HandleEvents (er: eventRecord): boolean;
                override;
                procedure DoItem (item: integer);
                procedure DoItemWhere (er: eventRecord; item: integer);
                procedure DoCancel (modifiers: integer; ch: char; code: integer);
                procedure DoOK (modifiers: integer; ch: char; code: integer);
                procedure SetEditMenuItem (item: integer);
                override;
                function EditMenuEnabled: boolean;
                override;
                procedure DoEditMenu (item: integer);
                override;
                function DoIsDialogEvent (er: eventRecord): boolean;
                override;
                function GetAESelection (var reply: AppleEvent): OSErr;
                override;
                procedure CalculateRegion (var rgn: rgnHandle);
                override;
            end;

    var
        default_object: WObject;
        edit_menu_always_enabled: boolean;
        last_event_time: longInt;
        last_event_modifers: integer;
        last_event_had_option: boolean;
        last_event_had_command: boolean;
        last_event_had_shift: boolean;
        last_event_had_control: boolean;
        has_DragManager: boolean;

    procedure StartupMainLoop;
    procedure ConfigureMainLoop (dobj: DObject);
{ dobj will be used returned with window set to wp whenever GetWObject/GetDObject is called with a DA or nil window }
    function GetWType (wp: windowPtr): OSType;
    function GetWObject (wp: windowPtr): WObject;
    function GetDObject (dlg: dialogPtr): DObject;
    function FrontObject: WObject;
    function IsWObjectFront (o: WObject): boolean;
    function FindWindowID (id: longInt): WObject;
    procedure DoCloseAll (all: boolean);

implementation

    uses
        Memory, ToolUtils, Scrap, Fonts, Resources, Errors, DiskInit, AEObjects, AERegistry,
        CodeFragments, Drag, Script, Processes, GestaltEqu, MixedMode, MyStartup,
        MyMenus, MyTypes, MyFMenus, BaseGlobals, MySystemGlobals, MyCursors,MyCallProc,MyCleverAlerts,
        MyTEUtils, MyAssertions, MyDialogs, MyAEUtils, MyWindows, MyMathUtils, QLowLevel, MyUtils;

    const
        titlebar_hight = 18;

    const
{ from EPPC }
        OOMagic = 'MyOO';
        BadOOMagic = 'bado';

    type
        myWindowRecord = record
                thewindow: windowRecord;
                magic: OSType;
            end;
        myWindowPtr = ^myWindowRecord;
        myDialogRecord = record
                thedialog: dialogRecord;
                magic: OSType;
            end;
        myDialogPtr = ^myDialogRecord;

    var
        last_window_id: longInt;
        gMyDragSendProc : UniversalProcPtr;

    procedure DoCloses (all: boolean);
        var
            fw: WindowPtr;
    begin
        if all then begin
            fw := FrontWindow;
            while fw <> nil do begin
                FrontObject.DoClose;
                if fw = FrontWindow then begin
                    leave;
                end;
                fw := FrontWindow;
            end;
        end
        else begin
            FrontObject.DoClose;
        end;
    end;

    function HandleClose (var event, reply: AppleEvent; refcon: longInt): OSErr;
        var
            err: OSErr;
    begin
        event:=event; { UNUSED! }
        reply:=reply; { UNUSED! }
        if FrontWindow <> nil then begin
            DoCloses(refcon <> 0);
            err := noErr;
        end
        else begin
            err := errAENoSuchObject;
        end;
        HandleClose := err;
    end;

    procedure DoCloseAll (all: boolean);
    begin
        if has_AppleEvents then begin
            if all then begin
                SendSelfSimpleEvent(kAECoreSuite, kAECloseAll);
            end
            else begin
                SendSelfSimpleEvent(kAECoreSuite, kAEClose);
            end;
        end
        else begin
            DoCloses(all);
        end;
    end;

    function WObject.TrackingHandler (message: DragTrackingMessage; dragref: DragReference): OSErr;
    begin
        message:=message; { UNUSED! }
        dragref:=dragref;
        TrackingHandler := -1;
    end;

    function MyTrackingHandler (message: DragTrackingMessage; window: WindowPtr; refcon: Ptr; dragref: DragReference): OSErr;
    begin
        refcon:=refcon; { UNUSED! }
        MyTrackingHandler := GetWObject(window).TrackingHandler(message, dragref);
    end;

    function WObject.ReceiveHandler (dragref: DragReference): OSErr;
    begin
        dragref:=dragref; { UNUSED! }
        ReceiveHandler := -1;
    end;

    function MyReceiveHandler (window: WindowPtr; refcon: Ptr; dragref: DragReference): OSErr;
    begin
        refcon:=refcon; { UNUSED! }
        MyReceiveHandler := GetWObject(window).ReceiveHandler(dragref);
    end;

    function WObject.DragSend (flavor: FlavorType; item: ItemReference; dragref: DragReference): OSErr;
    begin
        flavor:=flavor; { UNUSED! }
        item:=item; { UNUSED! }
        dragref:=dragref; { UNUSED! }
        DragSend := -1;
    end;

    var
        drag_obj: WObject;

    function MyDragSend (flavor: FlavorType; refcon: Ptr; item: ItemReference; dragref: DragReference): OSErr;
    begin
        refcon:=refcon; { UNUSED! }
        MyDragSend := drag_obj.DragSend(flavor, item, dragref);
    end;

    function GetWRC (wp: windowPtr): WObject;
        var
            rc: longInt;
    begin
        rc := 0;
        if (wp <> nil) & (windowPeek(wp)^.windowKind >= 0) then begin
            if ((windowPeek(wp)^.windowKind = dialogKind) & (myDialogPtr(wp)^.magic = OOMagic)) | (myWindowPtr(wp)^.magic = OOMagic) then begin
                rc := GetWRefCon(wp);
            end;
        end;
        if rc = 0 then begin
            default_object.window := wp;
            rc := longInt(default_object);
        end;
        GetWRC := WObject(rc);
    end;

    function GetWType (wp: windowPtr): OSType;
        var
            wo: WObject;
    begin
        wo := GetWRC(wp);
        if wo.is_default_object then begin
            GetWType := WT_NotMine;
        end else begin
            GetWType := wo.window_type;
        end;
    end;

    function GetWObject (wp: windowPtr): WObject;
    begin
        GetWObject := GetWRC(wp);
    end;

    function FindWindowID (id: longInt): WObject;
        const
            WindowList = $9D6;
        type
            WindowPtrPtr = ^WindowPtr;
        var
            w: windowPtr;
            wo: WObject;
    begin
        FindWindowID := nil;
        if id <> bad_window_id then begin
            w := WindowPtrPtr(WindowList)^;
            while w <> nil do begin
                wo := GetWObject(w);
                if (not wo.is_default_object) & (wo.window_id = id) then begin
                    FindWindowID := wo;
                    leave;
                end;
                w := windowPtr(windowPeek(w)^.nextWindow);
            end;
        end;
    end;

    function GetDObject (dlg: dialogPtr): DObject;
    begin
        GetDObject := DObject(GetWRC(dlg));
    end;

    function FrontObject: WObject;
    begin
        FrontObject := GetWRC(FrontWindow);
    end;

    function IsWObjectFront (o: WObject): boolean;
    begin
        if o = nil then begin
            IsWObjectFront := false;
        end else if o.window = nil then begin
            IsWObjectFront := false;
        end else begin
            IsWObjectFront := o.window = FrontWindow;
        end;
    end;

    function WObject.DoSetupDrag (dragref: DragReference; dragrgn: RgnHandle): OSErr;
    begin
        dragref:=dragref; { UNUSED! }
        dragrgn:=dragrgn; { UNUSED! }
        DoSetupDrag := -1;
    end;

    procedure WObject.DoTrackDrag (var er: EventRecord);
        var
            err: OSErr;
            dragref: DragReference;
            dragrgn: RgnHandle;
    begin
        drag_obj := self;
        err := NewDrag(dragref);
        if err = noErr then begin
            dragrgn := NewRgn;
            err := MemError;
            if err = noErr then begin
                err := DoSetupDrag(dragref, dragrgn);
                if err = noErr then begin
                    err := SetDragSendProc(dragref, gMyDragSendProc, nil);
                end;
                if err = noErr then begin
                    CursorSetProcessing(false);
                    err := TrackDrag(dragref, er, dragrgn);
                end;
                DisposeRgn(dragrgn);
            end;
            err := DisposeDrag(dragref);
        end;
    end;

    function WObject.SaveChangesID (alert_id: integer): integer;
        var
            a: integer;
            title: str255;
    begin
        SelectWindow(window);
        GetWTitle(window, title);
        if quitNow then begin
            CleverParamText(title, GetGlobalString(quiting_str), '', '');
        end
        else begin
            CleverParamText(title, GetGlobalString(closing_str), '', '');
        end;
        a := CleverAlert(alert_id);
        SaveChangesID := a;
    end;

    function WObject.SaveChanges: SCType;
    begin
        SaveChanges := SCType(SaveChangesID(save_changes_alert_id) - 1);
    end;

    function WObject.EditMenuEnabled: boolean;
    begin
        if window = nil then begin
            EditMenuEnabled := false;
        end else begin
            EditMenuEnabled := windowPeek(window)^.windowKind < 0;
        end;
    end;

    function WObject.SetMenuBar: boolean;
        var
            oldEditEnabled, editEnabled: boolean;
    begin
        oldEditEnabled := GetIDItemEnable(M_Edit, 0);
        editEnabled := FrontObject.EditMenuEnabled or edit_menu_always_enabled;
        if editEnabled <> oldEditEnabled then begin
            SetIDItemEnable(M_Edit, 0, editEnabled);
        end;
        SetMenuBar := editEnabled <> oldEditEnabled;
    end;

    procedure WObject.SetMenus;
    begin
        SetFMenus;
    end;

    procedure WObject.SetEditMenuItem (item: integer);
    begin
        if not EditMenuEnabled then begin
            SetIDItemEnable(M_Edit, item, false);
        end;
    end;

    procedure WObject.DoEditMenu (item: integer);
        var
            dummyb: boolean;
    begin
        if item <= 6 then begin
            dummyb := SystemEdit(item - 1);
        end;
    end;

    function WObject.GetAESelection (var reply: AppleEvent): OSErr;
    begin
        reply:=reply; { UNUSED! }
        GetAESelection := errAENoUserSelection;
    end;

    function WObject.GetAEWindow (var windowrec: AERecord): OSErr;
        var
            err, junk: OSErr;
            s: str255;
            r: rect;
    begin
        AECreate(windowrec);
        if is_default_object then begin
            err := errAEDescNotFound;
        end
        else begin
            err := AECreateList(nil, 0, true, windowrec);
            GetWTitle(window, s);
            if err = noErr then begin
                junk := PutStringToAERecord(windowrec, pName, s);
                r := window^.portRect;
                SetPort(window);
                LocalToGlobal(r.topleft);
                LocalToGlobal(r.botright);
                junk := AEPutParamPtr(windowrec, keyAEBounds, typeQDRectangle, @r, SizeOf(r));
                junk := AEPutParamPtr(windowrec, keyAEPosition, typeQDPoint, @r.topleft, SizeOf(r.topleft));
            end;
        end;
        GetAEWindow := err;
    end;

    function WObject.DoMenuKey (er: eventRecord; ch: char): longInt;
    begin
        ch:=ch; { UNUSED! }
        DoMenuKey := DoFMenuKey(er);
    end;

    procedure WObject.CalculateRegion (var rgn: rgnHandle);
    begin
        CursorSetArrow;
        rgn := nil;
    end;

    function WObject.WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
        var
            rgn: rgnHandle;
    begin
        if (window <> nil) & IsWindowShaded(window) then begin
            CursorSetArrow;
            rgn := nil;
        end else begin
            CalculateRegion(rgn);
        end;
        CursorSetProcessing(false);
        WaitForEvent := WaitNextEvent(everyEvent, er, sleep, rgn);
        if rgn <> nil then begin
            DisposeRgn(rgn);
        end;
    end;

    procedure WObject.DoDiskEvent (message: longInt);
        var
            pt: point;
            oe: OSErr;
    begin
        if (HiWord(message) <> noErr) then begin
            pt.h := ((GetQDGlobals^.screenbits.bounds.Right - GetQDGlobals^.screenbits.bounds.Left - 304) div 2);
            pt.v := ((GetQDGlobals^.screenbits.bounds.Bottom - GetQDGlobals^.screenbits.bounds.Top - 156) div 3);
            CursorSetArrow;
            CursorSetProcessing(false);
            oe := DIBadMount(pt, message);
        end;
    end;

    procedure WObject.DoSuspendResume (resume: boolean);
    begin
        SetInForeground(resume);
        if FrontWindow <> nil then begin
            FrontObject.DoActivateDeactivate(resume);
        end;
        CursorSetArrow;
    end;

    procedure WObject.DoHighLevel (er: eventRecord);
        var
            oe: OSErr;
    begin
        if has_AppleEvents then begin
            oe := AEProcessAppleEvent(er);
        end;
    end;

    procedure WObject.JointCreate (id: integer); { Called for DefaultObject too! }
    begin
        MoveHHi(handle(self));
        HLock(handle(self));
        popup_title_menu := nil;
        AppleGuideWindowType := '';
        if window <> nil then begin
            SetWRefCon(window, ord4(self));
            GetWindowRect(window, unzoomed);
        end;
        zoomed := false;
        close_hides_window := false;
        SetRect(growRect, 63, 61, 25000, 25000);
        zoomSize.h := 30000;
        zoomSize.v := 30000;
        window_type := WT_Generic;
        draw_grow_icon := false;
        window_id := last_window_id;
        last_window_id := last_window_id + 1;
        resid := id;
        is_default_object := false;
        onlyone := nil;
        timetoclose:=false;
    end;

    procedure WObject.CreateBehind (id: integer; behind: WindowPtr);
        var
            wp: myWindowPtr;
    begin
        wp := myWindowPtr(NewPtr(SizeOf(myWindowRecord)));
        wp^.magic := OOMagic;
        window := GetNewWindow(id, ptr(wp), behind);
        JointCreate(id);
    end;

    procedure WObject.Create (id: integer);
    begin
        CreateBehind(id, POINTER(-1));
    end;

    procedure WObject.Destroy;
    begin
        if (window <> nil) & (GetWType(window) <> WT_NotMine) then begin
            myWindowPtr(window)^.magic := BadOOMagic;
            DisposeWindow(window);
            if onlyone <> nil then begin
                onlyone^ := nil;
            end;
            dispose(self);
        end;
    end;

    type
        savedWindowRecord = record
                windowpos: rect; { the window position }
                windowvis: rect; { the visible part of the title bar }
                zoomed: boolean;
                visible: boolean;
            end;
        savedWindowPtr = ^savedWindowRecord;
        savedWindowHandle = ^savedWindowPtr;

    procedure WObject.GetWindowPos (h: handle);
        var
            rgn: RgnHandle;
            r1, r2, global_portrect: rect;
    begin
        HUnlock(h);
        SetHandleSize(h, SizeOf(savedWindowRecord));
        HLock(h);
        with savedWindowHandle(h)^^ do begin
            SetPort(window);
            visible := windowPeek(window)^.visible;
            GetWindowPortRect(window, global_portrect);
            LocalToGlobal(global_portrect.topleft);
            LocalToGlobal(global_portrect.botright);
            windowpos := global_portrect;
            windowpos.top := windowpos.top - titlebar_hight; { title bar }
            rgn := NewRgn;
            RectRgn(rgn, windowpos);
            SectRgn(GetGrayRgn, rgn, rgn);
            windowvis := rgn^^.rgnBBox;
            DisposeRgn(rgn);
            r1 := global_portrect;
            GetWindowStandardState(window, r2);
            InsetRect(r1, -7, -7);
            zoomed := PtInRect(r2.topLeft, r1) and PtInRect(r2.botRight, r1);
        end;
        HUnlock(h);
    end;

    procedure WObject.SetWindowPos (h: handle; var wasvisible: boolean);
        var
            rgn: RgnHandle;
            r: rect;
            dummy: boolean;
    begin
        if (h <> nil) & (GetHandleSize(h) = SizeOf(savedWindowRecord)) then begin
            HLock(h);
            with savedWindowHandle(h)^^ do begin
                wasvisible := visible;
                rgn := NewRgn;
                RectRgn(rgn, windowvis);
                SectRgn(GetGrayRgn, rgn, rgn);
                r := rgn^^.rgnBBox;
                DisposeRgn(rgn);
                dummy := SectRect(r, windowvis, r);
                if (longInt(r.topleft) = longInt(windowvis.topleft)) & (longInt(r.botright) = longInt(windowvis.botright)) then begin
                    with windowpos do begin
                        MoveWindow(window, left, top + titlebar_hight, true);
                        SizeWindow(window, right - left, bottom - top - titlebar_hight, true);
                    end;
                end;
                if zoomed then begin
                    Zoom(true, false);
                end
                else begin
                    Resize;
                end;
            end;
            HUnlock(h);
        end
        else
            wasvisible := true;
    end;

    procedure WObject.DoClose;
    begin
        if close_hides_window then begin
            HideWindow(window);
        end
        else begin
            Destroy;
        end;
    end;

    procedure WObject.DoContent (er: eventRecord);
    begin
        er:=er; { UNUSED! }
    end;

    procedure WObject.DoKey (modifiers: integer; ch: char; code: integer);
    begin
        modifiers:=modifiers; { UNUSED! }
        ch:=ch; { UNUSED! }
        code:=code; { UNUSED! }
        SysBeep(1);
    end;

    procedure WObject.DoSpecialKey (modifiers: integer; ch: char; code: integer);
        var
            item: integer;
    begin
        item := -1;
        if not system7 then begin
            case code of
                undoKey:
                    item := EMundo;
                cutKey:
                    item := EMcut;
                copyKey:
                    item := EMcopy;
                pasteKey:
                    item := EMpaste;
                clearKey:
                    item := EMclear;
                otherwise
                    ;
            end;
        end;
        if item <> -1 then begin
            SetMenus;
            if not GetIDItemEnable(M_Edit, 0) or not GetIDItemEnable(M_Edit, item) then begin
                item := -1;
            end;
        end;
        if item = -1 then begin
            DoKey(modifiers, ch, code);
        end
        else begin
            DoFMenu(M_Edit, item);
        end;
    end;

    procedure WObject.DoAutoKey (modifiers: integer; ch: char; code: integer);
    begin
        DoKey(modifiers, ch, code);
    end;

    procedure WObject.DoDrag (where: point);
        var
            temprect: rect;
    begin
        SetPort(window);
        tempRect := GetGrayRgn^^.rgnBBox;
        DragWindow(window, where, tempRect);
    end;

    procedure WObject.DoGrow (where: point);
        var
            mypt: point;
            oldrect: rect;
            mResult: longInt;
            tempRect: rect;
    begin
        SetPort(window);
        myPt := where;
        GlobalToLocal(myPt);
        GetWindowPortRect(window, oldrect);
        mResult := GrowWindow(window, where, growRect);
        SizeWindow(window, LoWord(mResult), HiWord(mResult), TRUE);
        SetRect(tempRect, 0, myPt.v - 15, myPt.h + 15, myPt.v + 15);
        EraseRect(tempRect);
        InvalRect(tempRect);
        SetRect(tempRect, myPt.h - 15, 0, myPt.h + 15, myPt.v + 15);
        EraseRect(tempRect);
        InvalRect(tempRect);
        zoomed := false;
        Resize;
    end;

    procedure WObject.Zoom (zoomout: boolean; fullscreen: boolean);
        var
            zoompt: Point;
    begin
        if fullscreen then begin
            SetPt(zoompt, 30000, 30000);
        end
        else begin
            zoompt := zoomSize;
        end;
        zoompt.h := Max(zoompt.h, growRect.left);
        zoompt.v := Max(zoompt.v, growRect.top);
        ZoomTheWindow(window, zoomout, zoompt, unzoomed);
        Resize;
        zoomed := zoomout;
    end;

    procedure WObject.DoZoom (where: point; code: integer);
    begin
        SetPort(window);
        if TrackBox(window, where, code) then begin
            Zoom(not zoomed, last_event_had_option);
        end;
    end;

    procedure WObject.InitialZoom (h, v: integer);
        var
            old: Point;
    begin
        Resize;
        old := zoomSize;
        if h <> 0 then begin
            zoomSize.h := h;
        end;
        if v <> 0 then begin
            zoomSize.v := v;
        end;
        Zoom(true, false);
        zoomSize := old;
        zoomed := false;
        GetWindowRect(window, unzoomed);
    end;

    procedure WObject.DoGoAway (where: point);
    begin
        if TrackGoAway(window, where) then begin
            DoCloseAll(last_event_had_option);
        end;
    end;

    procedure WObject.DoUpdate;
    begin
        BeginUpdate(window);
        Draw;
        EndUpdate(window);
    end;

    procedure WObject.TextChanged;
    begin
    end;

    procedure WObject.DoMouseMoved (where: point);
    begin
        where:=where; { UNUSED! }
    end;

    procedure WObject.DrawGrow;
    begin
        DrawGrowIcon(window);
    end;

    procedure WObject.DoActivateDeactivate (activate: boolean);
    begin
        Assert(window <> nil);
        is_active := activate and windowPeek(window)^.visible;
        if is_active then begin
            SelectWindow(window);
        end;
        if draw_grow_icon then begin
            DrawGrow;
        end;
    end;

    procedure WObject.Resize;
    begin
        if draw_grow_icon then begin
            DrawGrow;
        end;
    end;

    procedure WObject.Draw;
    begin
        if draw_grow_icon then begin
            DrawGrow;
        end;
    end;

    function WObject.DoIsDialogEvent (er: eventRecord): boolean;
    begin
        DoIsDialogEvent := IsDialogEvent(er);
    end;

    function WObject.DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
    begin
        DoDialogSelect := DialogSelect(er, dlg, item);
    end;

    procedure WObject.DoIdle;
    begin
    end;

    procedure WObject.DoIdleAlways;
    begin
        if timetoclose then begin
            DoClose;
        end;
    end;

    procedure WObject.DoPopupTitle (choice: integer);
    begin
        choice:=choice; { UNUSED! }
    end;

    function WObject.CheckPopupTitle (where: Point): boolean;
        var
            result: longInt;
            center, width: integer;
            saved: SavedWindowInfo;
            title: Str255;
            base: Point;
    begin
        CheckPopupTitle := false;
        if popup_title_menu <> nil then begin
            EnterWindow(window, MFT_System0, [], saved);
            GlobalToLocal(where);
            GetWTitle(window, title);
            center := (window^.portRect.right + window^.portRect.left) div 2;
            width := StringWidth(title);
            base.h := center - width div 2 - 14;
            base.v := -17;
            if (where.v < 0) & (base.h <= where.h) & (where.h <= center + width div 2 + 5) then begin
                CheckPopupTitle := true;
                InsertMenu(popup_title_menu, -1);
                LocalToGlobal(base);
                CheckItem(popup_title_menu, 1, true);
                result := PopUpMenuSelect(popup_title_menu, base.v, base.h, 1);
                CheckItem(popup_title_menu, 1, false);
                DeleteMenu(popup_title_menu^^.menuID);
                if (HiWord(result) <> 0) and (LoWord(result) <> 1) then begin
                    DoPopupTitle(LoWord(result));
{DrawPopUp(dialog, item);}
                end;
            end;
            ExitWindow(saved);
        end;
    end;

    function WObject.DoMainClick (er: eventRecord; wp: windowPtr; code: integer): boolean;
        var
            b: boolean;
            mResult: longInt;
            needsselect: boolean;
    begin
        b := false;
        needsselect := (wp <> nil) & (wp <> FrontWindow);
        if needsselect & not (code in [inDrag, inContent]) then begin
            SelectWindow(wp);
        end;
        case code of
            inMenuBar:  begin
                SetMenus;
                mResult := MenuSelect(er.where);
                if mResult <> 0 then begin
                    DoFMenu(HiWord(mResult), LoWord(mResult));
                end;
                if not quitNow then begin
                    HiliteMenu(0);
                end;
            end;
            InDrag:  begin
                if needsselect | not last_event_had_command | not CheckPopupTitle(er.where) then begin
                    if needsselect and not last_event_had_command then begin
                        SelectWindow(wp);
                    end;
                    DoDrag(er.where);
                end;
            end;
            inGrow:
                DoGrow(er.where);
            inZoomIn, inZoomOut:
                DoZoom(er.where, code);
            inGoAway:
                DoGoAway(er.where);
            inContent:  begin
                if needsselect then begin
                    SelectWindow(wp);
                end;
                DoContent(er);
            end;
            inSysWindow:
                SystemClick(er, window);
            otherwise
                b := true;
        end;
        DoMainClick := b;
    end;

    function WObject.HandleSimpleEvents (er: eventRecord): boolean;
        var
            b: boolean;
            ch: char;
            mResult: longInt;
            code: integer;
            wp: WindowPtr;
    begin
        b := false;
        case er.what of
            MouseDown:  begin
                code := FindWindow(er.where, wp);
                if wp = nil then begin
                    wp := FrontWindow;
                end;
                b := GetWObject(wp).DoMainClick(er, wp, code);
            end;

            KeyDown:  begin
                ch := chr(BAND(er.message, CharCodeMask));
                mResult := 0;
                if last_event_had_command then begin
                    SetMenus;
                    mResult := DoMenuKey(er, ch);
                end;
                if mResult <> 0 then begin
                    DoFMenu(HiWord(mResult), LoWord(mResult));
                end
                else begin
                    DoSpecialKey(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
                end;
            end;

            AutoKey:
                DoAutoKey(er.modifiers, chr(BAND(er.message, CharCodeMask)), BAND(er.message, keyCodeMask) div $100);

            UpdateEvt:
                GetWObject(windowPtr(er.message)).DoUpdate;

            ActivateEvt:
                GetWObject(windowPtr(er.message)).DoActivateDeactivate(odd(er.modifiers));

            kOSEvent:
                if BAND(BROTL(er.message, 8), $FF) = kSuspendResumeMessage then begin
                    DoSuspendResume(BAnd(er.message, kResumeMask) <> 0);
                end
                else if BAND(BROTL(er.message, 8), $FF) = kMouseMovedMessage then begin
                    DoMouseMoved(er.where);
                end
                else begin
                    b := true;
                end;

            kHighLevelEvent:
                DoHighLevel(er);

            DiskEvt:
                DoDiskEvent(er.message);

            otherwise
                b := true;
        end;
        HandleSimpleEvents := b;
    end;

    function WObject.HandleEvents (er: eventRecord): boolean;
        var
            b: boolean;
            dlg: dialogPtr;
            item: integer;
            dlgsel:boolean;
    begin
        last_event_time := er.when;
        last_event_modifers := er.modifiers;
        last_event_had_option := BAND(er.modifiers, optionKey) <> 0;
        last_event_had_command := BAND(er.modifiers, cmdKey) <> 0;
        last_event_had_shift := BAND(er.modifiers, shiftKey) <> 0;
        last_event_had_control := BAND(er.modifiers, controlKey) <> 0;
        DoIdle;
        b := true;
        if DoIsDialogEvent(er) then begin
            dlgsel:=DoDialogSelect(er, dlg, item);
            if dlgsel then begin
                GetDObject(dlg).DoItemWhere(er, item);
                b := false;
            end;
        end;
        if b then begin
            b := HandleSimpleEvents(er);
        end;
        HandleEvents := b;
    end;

    procedure DObject.CreateBehind (id: integer; behind: WindowPtr);
        var
            wp: myDialogPtr;
    begin
        disable_edit_menu := false;
        wp := myDialogPtr(NewPtr(SizeOf(myDialogRecord)));
        wp^.magic := OOMagic;
        window := GetNewDialog(id, ptr(wp), behind);
        ok_item := 0;
        cancel_item := 0;
        handle_activate_outline := false;
        handle_shift_tab := true;
        text_return := false;
        JointCreate(id);
    end;

    procedure DObject.Create (id: integer);
    begin
        CreateBehind(id, POINTER(-1));
    end;

    procedure DObject.Destroy;
    begin
        if (window <> nil) & (GetWType(window) <> WT_NotMine) then begin
            myDialogPtr(window)^.magic := BadOOMagic;
            DisposeDialog(window);
            if onlyone <> nil then begin
                onlyone^ := nil;
            end;
            dispose(self);
        end;
    end;

    procedure DObject.DrawOutline;
    begin
        OutlineDefault1(window, outline_item);
    end;

    procedure DObject.SetOOOutline (def_item, user_item: integer);
    begin
        handle_activate_outline := true;
        ok_item := def_item;
        outline_item := user_item;
        SetUpDefaultOutline(window,ok_item, outline_item);
    end;

    procedure DObject.DoActivateDeactivate (activate: boolean);
    begin
        inherited DoActivateDeactivate(activate);
        if handle_activate_outline then begin
            DrawOutline;
        end;
    end;

    procedure DObject.DoOK (modifiers: integer; ch: char; code: integer);
    begin
        if ok_item = 0 then begin
            DoKey(modifiers, ch, code);
        end
        else begin
            if GetDCtlEnable(window, ok_item) then begin
                FlashDItem(window, ok_Item);
                DoItem(ok_item);
            end;
        end;
    end;

    procedure DObject.DoCancel (modifiers: integer; ch: char; code: integer);
    begin
        if cancel_item = 0 then begin
            DoKey(modifiers, ch, code);
        end else begin
            FlashDItem(window, cancel_Item);
            DoItem(cancel_item);
        end;
    end;

    procedure DObject.DoItem (item: integer);
    begin
        item:=item; { UNUSED! }
    end;

    procedure DObject.DoItemWhere (er: eventRecord; item: integer);
    begin
        er:=er; { UNUSED! }
        DoItem(item);
    end;

    function DObject.HandleEvents (er: eventRecord): boolean;
        var
            b: boolean;
            ch: char;
    begin
        b := true;
        if ((er.what = KeyDown) or (er.what = AutoKey)) then begin
            b := false;
            ch := chr(BAND(er.message, charCodeMask));
            if ((ch = chr(13)) & not text_return) | (ch = chr(3)) then begin
                DoOK(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
            end
            else if (ch = chr(27)) or ((ch = '.') and (BAND(er.modifiers, cmdKey) <> 0)) then begin
                DoCancel(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
            end
            else if (ch = tab) and (BAND(er.modifiers, shiftKey) <> 0) then begin
                if handle_shift_tab then begin
                    ShiftTab(window);
                end
                else begin
                    b := true;
                end;
            end
            else begin
                b := true;
            end;
        end;
        if b then begin
            b := inherited HandleEvents(er);
        end;
        HandleEvents := b;
    end;

    procedure DObject.SetEditMenuItem (item: integer);
    begin
        if is_default_object or disable_edit_menu or (SelectedTextItem(window) <= 0) then begin
            SetIDItemEnable(M_Edit, item, false);
        end
        else begin
            TESetEditMenuItem(dialogPeek(window)^.textH, false, 250, item);
        end;
    end;

    function DObject.EditMenuEnabled: boolean;
    begin
        if is_default_object or disable_edit_menu or (SelectedTextItem(window) <= 0) then begin
            EditMenuEnabled := false;
        end
        else begin
            EditMenuEnabled := TEEditMenuEnabled(dialogPeek(window)^.textH, false, 250);
        end;
    end;

    procedure DObject.DoEditMenu (item: integer);
        var
            loe: longInt;
            oe: OSErr;
    begin
        case item of
            EMUndo:
                ;
            EMCut:  begin
                DialogCut(window);
                loe := ZeroScrap;
                oe := TEToScrap;
                TextChanged;
            end;
            EMCopy:  begin
                DialogCopy(window);
                loe := ZeroScrap;
                oe := TEToScrap;
            end;
            EMPaste:  begin
                oe := TEFromScrap;
                DialogPaste(window);
                TextChanged;
            end;
            EMClear:  begin
                DialogDelete(window);
                TextChanged;
            end;
            EMSelectAll:  begin
                if (SelectedTextItem(window) > 0) then begin
                    SelectDialogItemText(window, SelectedTextItem(window), 0, maxInt);
                end;
            end;
            otherwise
                ;
        end;
    end;

    function DObject.GetAESelection (var reply: AppleEvent): OSErr;
        var
            err: OSErr;
    begin
        if not is_default_object & (SelectedTextItem(window) > 0) then begin
            err := PutTESelectionToAERecord(reply, keyDirectObject, dialogPeek(window)^.textH);
        end
        else begin
            err := errAENoUserSelection;
        end;
        GetAESelection := err;
    end;

    function DObject.DoIsDialogEvent (er: eventRecord): boolean;
    begin
        if ((er.what = keyDown) or (er.what = autoKey)) and last_event_had_command then begin
            DoIsDialogEvent := false; { Stop system 7 from doing the edit menu as well }
        end
        else begin
            DoIsDialogEvent := inherited DoIsDialogEvent(er);
        end;
    end;

    procedure DObject.CalculateRegion (var rgn: rgnHandle);
        var
            item,k:integer;
            pt:Point;
    begin
        rgn := nil;
        item:=0;
        if window<>nil then begin
            SetPort(window);
            GetMouse(pt);
            item:=FindDialogItem(window,pt)+1;
            if item>0 then begin
                GetDItemKind(window,item,k);
                if k<>editText then begin
                    item:=0;
                end;
            end;
        end;
        if item>0 then begin
            CursorSetIBeam;
        end else begin
            CursorSetArrow;
        end;
    end;

    function HasDragLib:boolean;
    begin
{$IFC GENERATINGPOWERPC}
        HasDragLib := longInt(@InstallTrackingHandler) <> kUnresolvedCFragSymbolAddress;
{$ELSEC}
        HasDragLib := true;
{$ENDC}
    end;

    function InitMainLoop(var msg: integer): OSStatus;
        var
            i: integer;
            dummy: boolean;
            dummy_er: eventRecord;
            junk: OSErr;
            err: OSErr;
            HandleCloseProc:UniversalProcPtr;
            gv: longInt;
    begin
        msg := msg; { Unused }
        has_DragManager := HasDragLib & (Gestalt(gestaltDragMgrAttr, gv) = noErr) & (BTST(gv, gestaltDragMgrPresent));
        gMyDragSendProc := NewDragSendDataProc(@MyDragSend);
        for i := 1 to 5 do begin
            dummy := EventAvail(everyEvent, dummy_er);
        end;
        if has_DragManager then begin
            err := InstallTrackingHandler(NewDragTrackingHandlerProc(@MyTrackingHandler), nil, nil);
            err := InstallReceiveHandler(NewDragReceiveHandlerProc(@MyReceiveHandler), nil, nil);
        end;
        default_object.window := nil;
        default_object.window_id := bad_window_id;
        default_object.JointCreate(0);
        default_object.is_default_object := true;
        default_object.window_type := WT_NotMine;
        last_window_id := 1;
        edit_menu_always_enabled := false;
        if has_AppleEvents then begin
            HandleCloseProc:=NewAEEventHandlerProc(@HandleClose);
            junk := AEInstallEventHandler(kAECoreSuite, kAEClose,HandleCloseProc , 0, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAECloseAll,HandleCloseProc , 1, false);
        end;
        InitMainLoop := noErr;
    end;

    procedure FinishMainLoop;
    begin
        dispose(default_object);
    end;

    procedure ConfigureMainLoop (dobj: DObject);
    begin
        default_object := dobj;
    end;

    procedure StartupMainLoop;
    begin
        StartupCleverAlerts;
        StartupCursors;
        StartupDialogs;
        StartupFMenus;
        SetStartup(InitMainLoop, nil, 0, FinishMainLoop);
    end;

end.
    procedure CallIdleAlways;
        var
            fw,next: WindowPtr;
    begin
        fw:=FrontWindow;
        while fw<>nil do begin
            next:=WindowPtr(WindowPeek(fw)^.nextWindow);
            GetWObject(fw).DoIdleAlways;
            fw:=next;
        end;
    end;